Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/ShowIconFamily.p

Text File | 1994-06-18 | 10.1 KB | 357 lines | [TEXT/PJMM]

unit ShowIconFamily;
(*}
{# Pascal conversion : Quinn}
{# Station : Eriodon}
{# Date : Tuesday, 11 February 1992}
{*)
interface

(*}
{    ShowIconFamily.c}
{    }
{    ShowINIT compatible routine that shows 'ICN#' and 'iclx' flavor icons.}
{    For use by all INITs in System 7 and beyond.}
{    }
{    by Patrick C. Beard.}
{    }
{    Instructions for use:}
{    }
{        • Create a family of icons with ResEdit 2.1 or later.  This will include}
{         'ICN#', 'icl4', & 'icl8' icons.}
{        • Use SetUpA4 to set up Think C globals.}
{        • Call ShowIconFamily() with the resource id of the family that you used.}
{    }
{    Enhancements:}
{        }
{        • Uses 'iclx' & 'ICN#' icons from the Finder's "icon family" in System 7.}
{        • Generates a position for icons that is guaranteed to be on screen, while}
{          remaining compatible with previous releases of ShowInit.}
{}
{    This code is completely public domain.  Let's hope this becomes a new standard.}
{    }
{    This code is derived from the original ShowInit by Paul Mercer, Darin Adler,}
{    Paul Snively, and Steve Capps.}
{    }
{    Special thanks to Ben Haller, Rob Vaterlaus for valuable suggestions and help.}
{    Also, thanks, and in memory of, Mouse Herrel, for bug detection.}
{}
{    Patrick C. Beard}
{    1/8/92}
{}
{    ------------------------------------------------------------------------------}
{    Modification History:}
{    }
{    1/8/92 - This version is for THINK C 5.0 or better. Uses MPW-style includes. PB}
{    8/2/91 - Wasn't calling ClosePort after using the port.  Bad thing.  Fixed.  PB}
{    11 Feb 1992 - Converted to Pascal (MPW and Think (hopefully))}
{    17 Feb 1992 - Changed default_delta_x to -1 to act like ShowInit}
{    ------------------------------------------------------------------------------}
{*)

    const
        default_delta_x = -1;

    procedure SHOWICON (id: integer; delta_x: integer);

implementation

{$ifc undefined THINK_Pascal}
    uses
        Types, OSUtils, QuickDraw, Resources, Memory;
{$endc}

    type
        qdGlobals = record
                private: array[0..75] of signedByte;
                randSeed: longint;
                screenBits: BitMap;
                arrow: Cursor;
                dkGray: Pattern;
                ltGray: Pattern;
                gray: Pattern;
                black: Pattern;
                white: Pattern;
                thePort: GrafPtr;
                theend: longint;
            end;

    procedure SHOWICON (id: integer; delta_x: integer);
        var
            theGrafPort: GrafPtr;
            theDepth: integer;

        procedure GetIconRect (var iconRect: Rect);
            (*}
{                GetIconRect() generates an appropriate rectangle to display the}
{                next INIT's icon in.  It is also responsible for updating the horizontal}
{                position in low memory.  This is a departure from the original ShowInit code,}
{                which updates low memory AFTER displaying the icon.  This code won't generate}
{                an icon position until it is certain that the icon can be loaded, so the}
{                same behaviour occurs.}
{                }
{                This routine also generates a rectangle which is guaranteed to be onscreen.  It}
{                does this by taking the horizontal offset modulo the screen width to generate}
{                the horizontal position of the icon, and the offset divided by the screen}
{                width to generate the proper row.}
{            *)

            function CalcCheckSum (i: integer): integer;
                (*}
{                    ShowInit's information is nestled at the tail end of CurApName.}
{                    It consists of a short which encodes the next horizontal offset,}
{                    and another short which is that value checksummed with the function below.}
{                *)
                const
                    check_sum_const = $1021;
                var
                    l: longint;
            begin
                (* 16 bit rol is not pleasant in Pascal )-: *)
                l := brotl(l, 1);
                l := band(l, $FFFE);
                if btst(i, 15) then begin
                    l := bor(l, 1);
                end; (* if *)
                CalcCheckSum := bxor(l, check_sum_const);
            end; (* CalcCheckSum *)

            const
                CurApName = $910;
                offset_addr = CurApName + 32 - 4;                (* both pointers to integers *)
                checksum_addr = CurApName + 32 - 2;

                initial_x_position = 8;        (* initial horizontal offset. *)
                y_offset = 40;                        (* constant from bottom to place the icon. *)
            type
                intPtr = ^integer;
            var
                screenWidth: integer;
                offset: integer;
                checksum: integer;
        begin
            screenWidth := theGrafPort^.portRect.right - theGrafPort^.portRect.left;
            offset := intPtr(offset_addr)^;
            checksum := intPtr(checksum_addr)^;

            (* if we are the first INIT to run we need to initialize the horizontal value. *)
            if CalcCheckSum(offset) <> checksum then begin
                offset := initial_x_position;
            end; (* if *)

            iconRect.left := offset mod screenWidth;
            iconRect.top := theGrafPort^.portRect.bottom - y_offset * (offset div screenWidth + 1);
            iconRect.right := iconRect.left + 32;
            iconRect.bottom := iconRect.top + 32;

            (* advance the position for the next icon. *)
            offset := offset + delta_x;

            intPtr(offset_addr)^ := offset;
            intPtr(checksum_addr)^ := CalcCheckSum(offset);
        end; (* GetIconRect *)

        procedure DrawBWIcon (iconid: integer);
            (* DrawBWIcon draws the 'ICN#' member of the icon family. *)
            var
                icon: Handle;
                iconRect: Rect;
                source, destination: BitMap;
        begin
            icon := Get1Resource('ICN#', iconid);
            if icon = nil then
                exit(DrawBWIcon);        (* yuk C conversion *)
            HLock(icon);

            GetIconRect(iconRect);

            (* prepare the source and destination bitmaps. *)
            source.baseAddr := Ptr(longint(icon^) + 128);                (* mask address. *)
            source.rowBytes := 4;
            SetRect(source.bounds, 0, 0, 32, 32);
            destination := theGrafPort^.portBits;

            (* transfer the mask. *)
            CopyBits(source, destination, source.bounds, iconREct, srcBic, nil);

            (* and the icon. *)
            source.baseAddr := icon^;
            CopyBits(source, destination, source.bounds, iconRect, srcOr, nil);

            ReleaseResource(icon);
        end; (* DrawBWIcon *)

        procedure DrawColorIcon (iconid: integer);
        (* DrawColorIcon draws the appropriate icon for the current screen depth. *)

            function ChooseIcon (iconid: integer; var suggestedDepth: integer): Handle;
                (*}
{                    ChooseIcon() chooses the optimal icon for the current screen depth.}
{                    }
{                    Priorities for choosing icons:}
{                        1. match the bit depth to the icon.}
{                        2. use alternate bit depth version if available.}
{                        3. draw the black & white version.}
{                *)
                var
                    icon: Handle;
            begin
                icon := nil;
                if suggestedDepth = 4 then begin
                    icon := Get1Resource('icl4', iconid);
                    if icon = nil then begin
                        icon := Get1Resource('icl8', iconid);
                        if icon <> nil then begin
                            suggestedDepth := 8;
                        end; (* if *)
                    end; (* if *)
                end
                else begin
                    suggestedDepth := 8;
                    icon := Get1Resource('icl8', iconid);
                    if icon = nil then begin
                        icon := Get1Resource('icl4', iconid);
                        if icon <> nil then begin
                            suggestedDepth := 4;
                        end; (* if *)
                    end; (* if *)
                end; (* if *)
                ChooseIcon := icon;
            end; (* ChooseIcon *)

            var
                depthToUse: integer;
                mask, icon: Handle;
                clut: CTabHandle;
                source: PixMapHandle;
                maskBits: BitMap;
                rowBytes: longint;
                iconRect, bounds: Rect;
        begin
            (* by default we will be using the actual depth of the screen. *)
            depthToUse := theDepth;
            icon := ChooseIcon(iconid, depthToUse);

            if icon = nil then begin
                DrawBWIcon(iconid);
                exit(DrawColorIcon);
            end; (* if *)

            HLock(icon);

            (* get the black & white icon to get the mask drawn. *)
            mask := Get1Resource('ICN#', iconid);
            if mask = nil then
                exit(DrawColorIcon);        (* C error checking (-: *)

            HLock(mask);

            (* get the correct color lookup table. *)
            clut := GetCTable(depthToUse);
            if clut = nil then
                exit(DrawColorIcon);        (* C error checking (-: *)

            (* create a pixmap to stick the icon bits into for screen blitting. *)
            source := NewPixMap;
            if source = nil then begin
                DisposCTable(clut);
                exit(DrawColorIcon);
            end; (* if *)

            (* set up the source pixmap with the appropriate bounds, depth, and clut. *)
            bounds.top := 0;
            bounds.left := 0;
            bounds.bottom := 32;
            bounds.right := 32;
            rowBytes := (depthToUse * 32 + 15) div 16 * 2;
            source^^.baseAddr := icon^;
            source^^.rowBytes := bor(LoWrd(rowBytes), $8000);
            source^^.bounds := bounds;
            source^^.pixelType := 0;                        (* chunky model. *)
            source^^.pixelSize := depthToUse;
            source^^.cmpCount := 1;                            (* if in 32 bit mode this will be 3, so must change. *)
            source^^.cmpSize := depthToUse;
            DisposCTable(source^^.pmTable);            (* dispose of default, uninitialized table. *)
            source^^.pmTable := clut;

            (* get position to draw icon in. *)
            GetIconRect(iconRect);

            (* prepare the mask bitmap. *)
            maskBits.baseAddr := Ptr(longint(mask^) + 128);
            maskBits.rowBytes := 4;
            maskBits.bounds := bounds;

            (* punch out the mask *)
            CopyBits(maskBits, theGrafPort^.portBits, bounds, iconRect, srcBic, nil);

            (* draw the actual color icon. *)
            HLock(Handle(source));
            CopyBits(BitMapPtr(source^)^, theGrafPort^.portBits, bounds, iconRect, srcOr, nil);

            (* release everything we've allocated. *)
            source^^.baseAddr := nil;
            DisposPixMap(source);

            (* release the icon and mask. *)
            ReleaseResource(icon);
            ReleaseResource(mask);
        end; (* DrawColorIcon *)

        const
            actual_default_delta_x = 40;
        var
            oldA5: longint;
            qd: qdGlobals;
            environment: SysEnvRec;
            colorPort: boolean;
            gp: CGrafPort;
            junklong: longint;
            junk: OSErr;
    begin
        oldA5 := SetA5(longint(@qd.theend));
        InitGraf(@qd.thePort);

        if delta_x = default_delta_x then begin
            delta_x := actual_default_delta_x;
        end; (* if *)

        (* find out what kind of machine this is *)
        junk := SysEnvirons(curSysEnvVers, environment);
        if environment.hasColorQD then begin
            theDepth := GetMainDevice^^.gdPMap^^.pixelSize;
            if theDepth < 4 then begin
                theDepth := 1;
            end; (* if *)
        end
        else begin
            theDepth := 1;
        end; (* if *)

        (* see what type of port to open. *)
        colorPort := (theDepth >= 4);
        theGrafPort := @gp;
        if colorPort then begin
            OpenCPort(CGrafPtr(theGrafPort));
        end
        else begin
            OpenPort(theGrafPort);
        end; (* if *)

        if theDepth = 1 then begin
            DrawBWIcon(id);
        end
        else begin
            DrawColorIcon(id);
        end; (* if *)

        if colorPort then begin
            CloseCPort(@gp);
        end
        else begin
            ClosePort(@gp);
        end; (* if *)

        junklong := SetA5(oldA5);
    end; (* ShowIcon *)

end. (* ShowIconFamily *)